home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / var / lib / dpkg / info / linux-base.postinst < prev    next >
Encoding:
Text File  |  2012-03-04  |  43.8 KB  |  1,725 lines
  1. #!/usr/bin/perl
  2.  
  3. # Copyright 2009-2011 Ben Hutchings
  4. #
  5. # This program is free software; you can redistribute it and/or modify
  6. # it under the terms of the GNU General Public License as published by
  7. # the Free Software Foundation; either version 2 of the License, or
  8. # (at your option) any later version.
  9. #
  10. # This program is distributed in the hope that it will be useful,
  11. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13. # GNU General Public License for more details.
  14. #
  15. # You should have received a copy of the GNU General Public License
  16. # along with this program; if not, write to the Free Software
  17. # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
  18.  
  19. use strict;
  20. use warnings;
  21. use Debconf::Client::ConfModule ':all';
  22. use FileHandle;
  23. use POSIX ();
  24. use UUID;
  25.  
  26. package DebianKernel::DiskId;
  27.  
  28. ### utility
  29.  
  30. sub id_to_path {
  31.     my ($id) = @_;
  32.     $id =~ m|^/|
  33.     or $id =~ s{^(LABEL|UUID)=}{'/dev/disk/by-' . lc($1) . '/'}e
  34.     or die "Could not map id $id to path";
  35.     return $id;
  36. }
  37.  
  38. ### /etc/fstab
  39.  
  40. sub fstab_next {
  41.     # Based on my_getmntent() in mount_mntent.c
  42.  
  43.     my ($file) = @_;
  44.     my $text = <$file>;
  45.     unless (defined($text)) {
  46.     return ();
  47.     }
  48.  
  49.     my $line = $text;
  50.     $line =~ s/\r?\n$//;
  51.     $line =~ s/^[ \t]*//;
  52.     if ($line =~ /^(#|$)/) {
  53.     return ($text);
  54.     } else {
  55.     return ($text,
  56.         map({ s/\\([0-7][0-7][0-7])/chr(oct($1) & 0xff)/eg; $_; }
  57.             split(/[ \t]+/, $line)));
  58.     }
  59. }
  60.  
  61. sub fstab_list {
  62.     my ($file) = @_;
  63.     my @bdevs;
  64.     while (1) {
  65.     my ($text, $bdev) = fstab_next($file);
  66.     last unless defined($text);
  67.     if (defined($bdev)) {
  68.         push @bdevs, $bdev;
  69.     }
  70.     }
  71.     return @bdevs;
  72. }
  73.  
  74. sub fstab_update {
  75.     my ($old, $new, $map) = @_;
  76.     while (1) {
  77.     my ($text, $bdev) = fstab_next($old);
  78.     last unless defined($text);
  79.     if (defined($bdev) && defined(my $id = $map->{$bdev})) {
  80.         $text =~ s/^(\s*\S+)(.*)/# $1$2\n$id$2/;
  81.     }
  82.     $new->print("$text");
  83.     }
  84. }
  85.  
  86. ### Kernel parameters
  87.  
  88. sub kernel_list {
  89.     my ($cmd_line) = @_;
  90.     return ($cmd_line =~ /\broot=(\S+)/) ? ($1) : ();
  91. }
  92.  
  93. sub kernel_update {
  94.     my ($cmd_line, $map) = @_;
  95.     if ($cmd_line =~ /\broot=(\S+)/ && defined(my $id = $map->{$1})) {
  96.     $cmd_line =~ s/\broot=(\S+)/root=$id/;
  97.     return $cmd_line;
  98.     } else {
  99.     return undef;
  100.     }
  101. }
  102.  
  103. ### shell script variable assignment
  104.  
  105. # Maintains enough context to find statement boundaries, and can parse
  106. # variable definitions that do not include substitutions.  I think.
  107.  
  108. sub shellvars_next {
  109.     my ($file) = @_;
  110.     my $text = '';
  111.     my @context = ('');
  112.     my $first = 1;
  113.     my $in_value = 0;
  114.     my ($name, $value);
  115.     my $unhandled = 0;
  116.  
  117.   LINE:
  118.     while (<$file>) {
  119.     $text .= $_;
  120.  
  121.     # variable assignment
  122.     if ($first && m/^\s*([A-Za-z_][A-Za-z0-9_]*)=/g) {
  123.         $name = $1;
  124.         $value = '';
  125.         $in_value = 1;
  126.     }
  127.  
  128.     while (/\G(.*?)([#`'"(){}\s]|\\.|\$[({]?)/gs) {
  129.         my $end_pos = pos;
  130.         my $special = $2;
  131.  
  132.         if ($in_value) {
  133.         # add non-special characters to the value verbatim
  134.         $value .= $1;
  135.         }
  136.  
  137.         if ($context[$#context] eq '') {
  138.         # space outside quotes or brackets ends the value
  139.         if ($special =~ /^\s/) {
  140.             $in_value = 0;
  141.             if ($special eq "\n") {
  142.             last LINE;
  143.             }
  144.         }
  145.         # something else after the value means this is a command
  146.         # with an environment override, not a variable definition
  147.         elsif (defined($name) && !$in_value) {
  148.             $unhandled = 1;
  149.         }
  150.         }
  151.  
  152.         # in single-quoted string
  153.         if ($context[$#context] eq "'") {
  154.         # only the terminating single-quote is special
  155.         if ($special eq "'") {
  156.             pop @context;
  157.         } else {
  158.             $value .= $special;
  159.         }
  160.         }
  161.         # backslash escape
  162.         elsif ($special =~ /^\\/) {
  163.         if ($in_value && $special ne "\\\n") {
  164.             $value .= substr($special, 1, 1);
  165.         }
  166.         }
  167.         # in backtick substitution
  168.         elsif ($context[$#context] eq '`') {
  169.         # backtick does not participate in nesting, so only the
  170.         # terminating backtick should be considered special
  171.         if ($special eq '`') {
  172.             pop @context;
  173.         }
  174.         }
  175.         # comment
  176.         elsif ($context[$#context] !~ /^['"]/ && $special eq '#') {
  177.         # ignore rest of the physical line, except the new-line
  178.         pos = $end_pos;
  179.         /\G.*/g;
  180.         next;
  181.         }
  182.         # start of backtick substitution
  183.         elsif ($special eq '`') {
  184.         push @context, '`';
  185.         $unhandled = 1;
  186.         }
  187.         # start of single/double-quoted string
  188.         elsif ($special =~ /^['"]/ && $context[$#context] !~ /^['"]/) {
  189.         push @context, $special;
  190.         }
  191.         # end of double-quoted string
  192.         elsif ($special eq '"' && $context[$#context] eq '"') {
  193.         pop @context;
  194.         }
  195.         # open bracket
  196.         elsif ($special =~ /^\$?\(/) {
  197.         push @context, ')';
  198.         $unhandled = 1;
  199.         } elsif ($special =~ /^\$\{/) {
  200.         push @context, '}';
  201.         $unhandled = 1;
  202.         }
  203.         # close bracket
  204.         elsif ($special =~ /^[)}]/ && $special eq $context[$#context]) {
  205.         pop @context;
  206.         }
  207.         # variable substitution
  208.         elsif ($special eq '$') {
  209.         $unhandled = 1;
  210.         }
  211.         # not a special character in this context (or a syntax error)
  212.         else {
  213.         if ($in_value) {
  214.             $value .= $special;
  215.         }
  216.         }
  217.  
  218.         pos = $end_pos;
  219.     }
  220.  
  221.     $first = 0;
  222.     }
  223.  
  224.     if ($text eq '') {
  225.     return ();
  226.     } elsif ($unhandled) {
  227.     return ($text);
  228.     } else {
  229.     return ($text, $name, $value);
  230.     }
  231. }
  232.  
  233. sub shellvars_quote {
  234.     my ($value) = @_;
  235.     $value =~ s/'/'\''/g;
  236.     return "'$value'";
  237. }
  238.  
  239. ### GRUB 1 (grub-legacy) config
  240.  
  241. sub grub1_path {
  242.     for ('/boot/grub', '/boot/boot/grub') {
  243.     if (-d) {
  244.         return "$_/menu.lst";
  245.     }
  246.     }
  247.     return undef;
  248. }
  249.  
  250. sub grub1_parse {
  251.     my ($file) = @_;
  252.     my @results = ();
  253.     my $text = '';
  254.     my $in_auto = 0;
  255.     my $in_opts = 0;
  256.  
  257.     while (<$file>) {
  258.     if ($in_opts && /^\# (\w+)=(.*)/) {
  259.         push @results, [$text];
  260.         $text = '';
  261.         push @results, [$_, $1, $2];
  262.     } else {
  263.         $text .= $_;
  264.         if ($_ eq "### BEGIN AUTOMAGIC KERNELS LIST\n") {
  265.         $in_auto = 1;
  266.         } elsif ($_ eq "### END DEBIAN AUTOMAGIC KERNELS LIST\n") {
  267.         $in_auto = 0;
  268.         } elsif ($_ eq "## ## Start Default Options ##\n") {
  269.         $in_opts = $in_auto;
  270.         } elsif ($_ eq "## ## End Default Options ##\n") {
  271.         $in_opts = 0;
  272.         }
  273.     }
  274.     }
  275.  
  276.     if ($text ne '') {
  277.     push @results, [$text];
  278.     }
  279.  
  280.     return @results;
  281. }
  282.  
  283. sub grub1_list {
  284.     my ($file) = @_;
  285.     my %options;
  286.     for (grub1_parse($file)) {
  287.     my ($text, $name, $value) = @$_;
  288.     next unless defined($name);
  289.     $options{$name} = $value;
  290.     }
  291.  
  292.     my @bdevs;
  293.     if (exists($options{kopt_2_6})) {
  294.     push @bdevs, kernel_list($options{kopt_2_6});
  295.     } elsif (exists($options{kopt})) {
  296.     push @bdevs, kernel_list($options{kopt});
  297.     }
  298.     if (exists($options{xenkopt})) {
  299.     push @bdevs, kernel_list($options{xenkopt});
  300.     }
  301.     return @bdevs;
  302. }
  303.  
  304. sub grub1_update {
  305.     my ($old, $new, $map) = @_;
  306.  
  307.     my %options;
  308.     for (grub1_parse($old)) {
  309.     my ($text, $name, $value) = @$_;
  310.     next unless defined($name);
  311.     $options{$name} = $value;
  312.     }
  313.  
  314.     $old->seek(0, 0);
  315.     for (grub1_parse($old)) {
  316.     my ($text, $name, $value) = @$_;
  317.     if (defined($name) && 
  318.         ($name eq 'kopt_2_6' ||
  319.          ($name eq 'kopt' && !exists($options{kopt_2_6})) ||
  320.          $name eq 'xenkopt')) {
  321.         if (defined(my $new_value = kernel_update($value, $map))) {
  322.         $text = "## $name=$value\n# $name=$new_value\n";
  323.         }
  324.     }
  325.     $new->print($text);
  326.     }
  327. }
  328.  
  329. sub grub1_post {
  330.     system('update-grub');
  331. }
  332.  
  333. ### GRUB 2 config
  334.  
  335. sub grub2_list {
  336.     my ($file) = @_;
  337.     my @bdevs;
  338.  
  339.     while (1) {
  340.     my ($text, $name, $value) = shellvars_next($file);
  341.     last unless defined($text);
  342.     if (defined($name) && $name =~ /^GRUB_CMDLINE_LINUX(?:_DEFAULT)?$/) {
  343.         push @bdevs, kernel_list($value);
  344.     }
  345.     }
  346.  
  347.     return @bdevs;
  348. }
  349.  
  350. sub grub2_update {
  351.     my ($old, $new, $map) = @_;
  352.     my @bdevs;
  353.  
  354.     while (1) {
  355.     my ($text, $name, $value) = shellvars_next($old);
  356.     last unless defined($text);
  357.     if (defined($name) && $name =~ /^GRUB_CMDLINE_LINUX(?:_DEFAULT)?$/ &&
  358.         defined(my $new_value = kernel_update($value, $map))) {
  359.         $text =~ s/^/# /gm;
  360.         $text .= sprintf("%s=%s\n", $name, shellvars_quote($new_value));
  361.     }
  362.     $new->print($text);
  363.     }
  364. }
  365.  
  366. sub grub2_post {
  367.     system('grub-mkconfig', '-o', '/boot/grub/grub.cfg');
  368. }
  369.  
  370. ### LILO
  371.  
  372. sub lilo_tokenize {
  373.     # Based on cfg_get_token() and next() in cfg.c.
  374.     # Line boundaries are *not* significant (except as white space) so
  375.     # we tokenize the whole file at once.
  376.  
  377.     my ($file) = @_;
  378.     my @tokens = ();
  379.     my $text = '';
  380.     my $token;
  381.     my $in_quote = 0;
  382.  
  383.     while (<$file>) {
  384.     # If this is the continuation of a multi-line quote, skip
  385.     # leading space and push back the necessary context.
  386.     if ($in_quote) {
  387.         s/^[ \t]*/"/;
  388.         $text .= $&;
  389.     }
  390.  
  391.     pos = 0;
  392.     while (/\G \s* (?:\#.*)?
  393.                 (?: (=) |
  394.                     " ((?:[^"] | \\[\\"n])*) (" | \\\r?\n) |
  395.                     ((?:[^\s\#="\\] | \\[^\r\n])+) (\\\r?\n)?)?
  396.                /gsx) {
  397.         my $cont;
  398.         my $new_text = $&;
  399.  
  400.         if (defined($1)) {
  401.         # equals sign
  402.         $text = $new_text;
  403.         $token = $1;
  404.         $cont = 0;
  405.         } elsif (defined($2)) {
  406.         # quoted text
  407.         if (!$in_quote) {
  408.             $text = $new_text;
  409.             $token = $2;
  410.         } else {
  411.             $text .= substr($new_text, 1); # remove the quote again; ick
  412.             $token .= ' ' . $2;
  413.         }
  414.         $cont = $3 ne '"';
  415.         } elsif (defined($4)) {
  416.         # unquoted word
  417.         if (!defined($token)) {
  418.             $token = '';
  419.         }
  420.         $text .= $new_text;
  421.         $token .= $4;
  422.         $cont = defined($5);
  423.         } else {
  424.         $text .= $new_text;
  425.         $cont = $new_text eq '';
  426.         }
  427.  
  428.         if (!$cont) {
  429.         if ($text =~ /(?:^|[^\\])\$/) {
  430.             # unhandled expansion
  431.             $token = undef;
  432.         } elsif (defined($token)) {
  433.             if ($in_quote) {
  434.             $token =~ s/\\(.)/$1 eq 'n' ? "\n" : $1/eg;
  435.             } else {
  436.             $token =~ s/\\(.)/$1/g;
  437.             }
  438.         }
  439.         push @tokens, [$text, $token];
  440.         $text = '';
  441.         $token = undef;
  442.         $in_quote = 0;
  443.         }
  444.     }
  445.     }
  446.  
  447.     return @tokens;
  448. }
  449.  
  450. sub lilo_list {
  451.     my ($file) = @_;
  452.     my @bdevs = ();
  453.     my @tokens = lilo_tokenize($file);
  454.     my $i = 0;
  455.     my $in_generic = 1; # global or image=/vmlinuz or image=/vmlinuz.old
  456.  
  457.     while ($i <= $#tokens) {
  458.     # Configuration items are either <name> "=" <value> or <name> alone.
  459.     if ($#tokens - $i >= 2 &&
  460.         defined($tokens[$i + 1][1]) && $tokens[$i + 1][1] eq '=') {
  461.         my ($name, $value) = ($tokens[$i][1], $tokens[$i + 2][1]);
  462.         if (defined($name) && defined($value)) {
  463.         if ($name eq 'image') {
  464.             $in_generic = ($value =~ m|^/vmlinuz(?:\.old)?$|);
  465.         } elsif ($in_generic) {
  466.             if ($name =~ /^(?:boot|root)$/) {
  467.             push @bdevs, $value;
  468.             } elsif ($name =~ /^(?:addappend|append|literal)$/) {
  469.             push @bdevs, kernel_list($value);
  470.             }
  471.         }
  472.         }
  473.         $i += 3;
  474.     } else {
  475.         $i += 1;
  476.     }
  477.     }
  478.  
  479.     return @bdevs;
  480. }
  481.  
  482. sub _lilo_update {
  483.     my ($old, $new, $map, $replace) = @_;
  484.     my @tokens = lilo_tokenize($old);
  485.     my $i = 0;
  486.     my $in_generic = 1; # global or image=/vmlinuz or image=/vmlinuz.old
  487.  
  488.     while ($i <= $#tokens) {
  489.     my $text = $tokens[$i][0];
  490.  
  491.     if ($#tokens - $i >= 2 &&
  492.         defined($tokens[$i + 1][1]) && $tokens[$i + 1][1] eq '=') {
  493.         my ($name, $value) = ($tokens[$i][1], $tokens[$i + 2][1]);
  494.         my $new_value;
  495.         if (defined($name) && defined($value)) {
  496.         if ($name eq 'image') {
  497.             $in_generic = ($value =~ m|^/vmlinuz(?:\.old)?$|);
  498.         } elsif ($in_generic) {
  499.             if ($name eq 'boot') {
  500.             # 'boot' is used directly by the lilo command, which
  501.             # doesn't use libblkid
  502.             $new_value = $map->{$value} && id_to_path($map->{$value});
  503.             } elsif ($name eq 'root') {
  504.             # 'root' adds a root parameter to the kernel command
  505.             # line
  506.             $new_value = $map->{$value};
  507.             } elsif ($name =~ /^(?:addappend|append|literal)$/) {
  508.             # These are all destined for the kernel command line
  509.             # in some way
  510.             $new_value = kernel_update($value, $map);
  511.             }
  512.         }
  513.         }
  514.         if (defined($new_value)) {
  515.         $new_value =~ s/\\/\\\\/g;
  516.         $text = &{$replace}($name, $value, $new_value) ||
  517.             "\n# $name = $value\n$name = \"$new_value\"\n";
  518.         } else {
  519.         $text .= $tokens[$i + 1][0] . $tokens[$i + 2][0];
  520.         }
  521.         $i += 3;
  522.     } else {
  523.         $i += 1;
  524.     }
  525.  
  526.     $new->print($text);
  527.     }
  528. }
  529.  
  530. sub lilo_update {
  531.     my ($old, $new, $map) = @_;
  532.     _lilo_update($old, $new, $map, sub { return undef });
  533. }
  534.  
  535. sub lilo_post {
  536.     system('lilo');
  537. }
  538.  
  539. ### SILO
  540.  
  541. sub silo_post {
  542.     system('silo');
  543. }
  544.  
  545. ### Yaboot
  546.  
  547. sub yaboot_post {
  548.     system('ybin');
  549. }
  550.  
  551. ### ELILO
  552.  
  553. sub elilo_update {
  554.     my ($old, $new, $map) = @_;
  555.     # Work around bug #581173 - boot value must have no space before
  556.     # and no quotes around it.
  557.     sub replace {
  558.     my ($name, $value, $new_value) = @_;
  559.     return ($name eq 'boot') ? "# boot=$value\nboot=$new_value\n" : undef;
  560.     }
  561.     _lilo_update($old, $new, $map, \&replace);
  562. }
  563.  
  564. sub elilo_post {
  565.     system('elilo');
  566. }
  567.  
  568. ### extlinux
  569.  
  570. sub extlinux_old_path {
  571.     for ('/boot/extlinux', '/boot/boot/exlinux', '/extlinux') {
  572.     if (-e) {
  573.         return "$_/options.cfg";
  574.     }
  575.     }
  576.     return undef;
  577. }
  578.  
  579. sub extlinux_old_list {
  580.     my ($file) = @_;
  581.     while (<$file>) {
  582.     if (/^## ROOT=(.*)/) {
  583.         return kernel_list($1);
  584.     }
  585.     }
  586.     return ();
  587. }
  588.  
  589. sub extlinux_old_update {
  590.     my ($old, $new, $map) = @_;
  591.     while (<$old>) {
  592.     my $text = $_;
  593.     if (/^## ROOT=(.*)/) {
  594.         my $new_params = kernel_update($1, $map);
  595.         if (defined($new_params)) {
  596.         $text = "## $text" . "## ROOT=$new_params\n";
  597.         }
  598.     }
  599.     $new->print($text);
  600.     }
  601. }
  602.  
  603. sub extlinux_new_list {
  604.     my ($file) = @_;
  605.     while (<$file>) {
  606.     if (/^# ROOT=(.*)/) {
  607.         return kernel_list($1);
  608.     }
  609.     }
  610.     return ();
  611. }
  612.  
  613. sub extlinux_new_update {
  614.     my ($old, $new, $map) = @_;
  615.     while (<$old>) {
  616.     my $text = $_;
  617.     if (/^# ROOT=(.*)/) {
  618.         my $new_params = kernel_update($1, $map);
  619.         if (defined($new_params)) {
  620.         $text = "## $text" . "# ROOT=$new_params\n";
  621.         }
  622.     }
  623.     $new->print($text);
  624.     }
  625. }
  626.  
  627. sub extlinux_post {
  628.     system('update-extlinux');
  629. }
  630.  
  631. # udev persistent-cd
  632.  
  633. sub udev_next {
  634.     my ($file) = @_;
  635.     my @results = ();
  636.  
  637.     # Based on parse_file() and get_key() in udev-rules.c
  638.     while (1) {
  639.     my $text = <$file>;
  640.     last if !defined($text) || $text eq '';
  641.  
  642.     if ($text =~ /^\s*(?:#|$)/) {
  643.         push @results, [$text];
  644.     } else {
  645.         my $end_pos = 0;
  646.         while ($text =~ /\G [\s,]* ((?:[^\s=+!:]|[+!:](?!=))+)
  647.                          \s* ([=+!:]?=) "([^"]*)"/gx) {
  648.         push @results, [$&, $1, $2, $3];
  649.         $end_pos = pos($text);
  650.         }
  651.         push @results, [substr($text, $end_pos)];
  652.         last if $text !~ /\\\n$/;
  653.     }
  654.     }
  655.  
  656.     return @results;
  657. }
  658.  
  659. sub udev_parse_symlink_rule {
  660.     my ($path, $symlink);
  661.     for (@_) {
  662.     my ($text, $key, $op, $value) = @$_;
  663.     next if !defined($key);
  664.     if ($key eq 'ENV{ID_PATH}' && $op eq '==') {
  665.         $path = $value;
  666.     } elsif ($key eq 'SYMLINK' && $op eq '+=') {
  667.         $symlink = $value;
  668.     }
  669.     }
  670.     return ($path, $symlink);
  671. }
  672.  
  673. # Find symlink rules using IDE device paths that aren't matched by rules
  674. # using the corresponding SCSI device path.  Return an array containing
  675. # the corresponding path for each rule where this is the case and undef
  676. # for all other rules.
  677. sub udev_cd_find_unmatched_ide_rules {
  678.     my ($file) = @_;
  679.     my %wanted_rule;
  680.     my @unmatched;
  681.     my $i = 0;
  682.  
  683.     while (1) {
  684.     my @keys = udev_next($file);
  685.     last if $#keys < 0;
  686.  
  687.     my ($path, $symlink) = udev_parse_symlink_rule(@keys);
  688.     if (defined($path) && defined($symlink)) {
  689.         if ($path =~ /-ide-\d+:\d+$/) {
  690.         # libata uses the PATA controller and device numbers
  691.         # as SCSI host number and bus id.  Channel number and
  692.         # LUN are always 0.  The parent device path should
  693.         # stay the same.
  694.         $path =~ s/-ide-(\d+):(\d+)$/-scsi-$1:0:$2:0/;
  695.         my $rule_key =  $path . ' ' . $symlink;
  696.         if (!exists($wanted_rule{$rule_key})) {
  697.             $wanted_rule{$rule_key} = $i;
  698.             $unmatched[$i] = $path;
  699.         }
  700.         } elsif ($path =~ /-scsi-\d+:\d+:\d+:\d+$/) {
  701.         my $rule_key =  $path . ' ' . $symlink;
  702.         my $j = $wanted_rule{$rule_key};
  703.         if (defined($j) && $j >= 0) {
  704.             $unmatched[$j] = undef;
  705.         }
  706.         $wanted_rule{$rule_key} = -1;
  707.         }
  708.     }
  709.  
  710.     ++$i;
  711.     }
  712.  
  713.     return @unmatched;
  714. }
  715.  
  716. sub udev_cd_needs_update {
  717.     my ($file) = @_;
  718.     my %paths;
  719.     for (udev_cd_find_unmatched_ide_rules($file)) {
  720.     if (defined($_)) {
  721.         $paths{$_} = 1;
  722.     }
  723.     }
  724.     return join('\n', map({"+ PATH=$_"} keys(%paths)));
  725. }
  726.  
  727. sub udev_cd_update {
  728.     my ($old, $new) = @_; # ignore map
  729.  
  730.     # Find which rules we will need to copy and edit, then rewind
  731.     my @unmatched = udev_cd_find_unmatched_ide_rules($old);
  732.     $old->seek(0, 0);
  733.  
  734.     my $i = 0;
  735.     while (1) {
  736.     my @keys = udev_next($old);
  737.     last if $#keys < 0;
  738.  
  739.     my $old_text = '';
  740.     my $new_text = '';
  741.  
  742.     for (@keys) {
  743.         my ($text, $key, $op, $value) = @$_;
  744.         $old_text .= $text;
  745.         next unless defined($unmatched[$i]) && defined($key);
  746.  
  747.         if ($key eq 'ENV{ID_PATH}' && $op eq '==') {
  748.         my $value = $unmatched[$i];
  749.         $new_text .= ", $key$op\"$value\"";
  750.         } else {
  751.         $new_text .= $text;
  752.         }
  753.     }
  754.  
  755.     $new->print($old_text);
  756.     if ($unmatched[$i]) {
  757.         $new->print($new_text . "\n");
  758.     }
  759.  
  760.     ++$i;
  761.     }
  762. }
  763.  
  764. # initramfs-tools resume
  765.  
  766. sub initramfs_resume_list {
  767.     my ($file) = @_;
  768.     my @results = ();
  769.  
  770.     while (1) {
  771.     my ($text, $name, $value) = shellvars_next($file);
  772.     last unless defined($text);
  773.     if (defined($name) && $name eq 'RESUME') {
  774.         $results[0] = $value;
  775.     }
  776.     }
  777.  
  778.     return @results;
  779. }
  780.  
  781. sub initramfs_resume_update {
  782.     my ($old, $new, $map) = @_;
  783.  
  784.     while (1) {
  785.     my ($text, $name, $value) = shellvars_next($old);
  786.     last unless defined($text);
  787.     if (defined($name) && $name eq 'RESUME' &&
  788.         defined(my $new_value = $map->{$value})) {
  789.         $text =~ s/^/# /gm;
  790.         $text .= sprintf("%s=%s\n", $name, shellvars_quote($new_value));
  791.     }
  792.     $new->print($text);
  793.     }
  794. }
  795.  
  796. # uswsusp resume
  797.  
  798. sub uswsusp_next {
  799.     # Based on parse_line() in config_parser.c
  800.  
  801.     my ($file) = @_;
  802.     my $text = <$file>;
  803.  
  804.     if (!defined($text) || $text eq '') {
  805.     return ();
  806.     }
  807.  
  808.     local $_ = $text;
  809.     s/^\s*(?:#.*)?//;
  810.     s/\s*$//;
  811.  
  812.     if ($text =~ /^([\w ]*\w)[ \t]*[:=][ \t]*(.+)$/) {
  813.     return ($text, $1, $2);
  814.     } else {
  815.     return ($text);
  816.     }
  817. }
  818.  
  819. sub uswsusp_resume_list {
  820.     my ($file) = @_;
  821.     my @results = ();
  822.  
  823.     while (1) {
  824.     my ($text, $name, $value) = uswsusp_next($file);
  825.     last unless defined($text);
  826.     if (defined($name) && $name eq 'resume device') {
  827.         $results[0] = $value;
  828.     }
  829.     }
  830.  
  831.     return @results;
  832. }
  833.  
  834. sub uswsusp_resume_update {
  835.     my ($old, $new, $map) = @_;
  836.  
  837.     while (1) {
  838.     my ($text, $name, $value) = uswsusp_next($old);
  839.     last unless defined($text);
  840.     if (defined($name) && $name eq 'resume device' &&
  841.         defined(my $new_value = $map->{$value})) {
  842.         $text =~ s/^/# /gm;
  843.         $text .= sprintf("%s = %s\n", $name, id_to_path($new_value));
  844.     }
  845.     $new->print($text);
  846.     }
  847. }
  848.  
  849. # cryptsetup
  850.  
  851. sub cryptsetup_next {
  852.     my ($file) = @_;
  853.     my $text = <$file>;
  854.     unless (defined($text)) {
  855.     return ();
  856.     }
  857.  
  858.     my $line = $text;
  859.     if ($line =~ /^\s*(#|$)/) {
  860.     return ($text);
  861.     } else {
  862.     $line =~ s/\s*$//;
  863.     $line =~ s/^\s*//;
  864.     return ($text, split(/\s+/, $line, 4));
  865.     }
  866. }
  867.  
  868. sub cryptsetup_list {
  869.     my ($file) = @_;
  870.     my (@results) = ();
  871.  
  872.     while (1) {
  873.     my ($text, undef, $src) = cryptsetup_next($file);
  874.     last unless defined($text);
  875.     if (defined($src)) {
  876.         push @results, $src;
  877.     }
  878.     }
  879.  
  880.     return @results;
  881. }
  882.  
  883. sub cryptsetup_update {
  884.     my ($old, $new, $map) = @_;
  885.  
  886.     while (1) {
  887.     my ($text, $dst, $src, $key, $opts) = cryptsetup_next($old);
  888.     last unless defined($text);
  889.     if (defined($src) && defined($map->{$src})) {
  890.         $text = "# $text" .
  891.         join(' ', $dst, $map->{$src}, $key, $opts) . "\n";
  892.     }
  893.     $new->print($text);
  894.     }
  895. }
  896.  
  897. # hdparm
  898.  
  899. sub hdparm_list {
  900.     my ($file) = @_;
  901.     my (@results) = ();
  902.  
  903.     # I really can't be bothered to parse this mess.  Just see if
  904.     # there's anything like a device name on a non-comment line.
  905.     while (<$file>) {
  906.     if (!/^\s*#/) {
  907.         push @results, grep({m|^/dev/|} split(/\s+/));
  908.     }
  909.     }
  910.  
  911.     return @results;
  912. }
  913.  
  914. ### mdadm
  915.  
  916. sub mdadm_list {
  917.     my ($file) = @_;
  918.     my (@results) = ();
  919.  
  920.     while (<$file>) {
  921.     # Look for DEVICE (case-insensitive, may be abbreviated to as
  922.     # little as 3 letters) followed by a whitespace-separated list
  923.     # of devices (or wildcards, or keywords!).  Ignore comments
  924.     # (hash preceded by whitespace).
  925.     if (/^DEV(?:I(?:C(?:E)?)?)?[ \t]*((?:[^ \t]|[ \t][^#])*)/i) {
  926.         push @results, split(/[ \t]+/, $1);
  927.     }
  928.     }
  929.  
  930.     return @results;
  931. }
  932.  
  933. ### list of all configuration files and functions
  934.  
  935. my @config_files = ({packages => 'mount',
  936.              path => '/etc/fstab',
  937.              list => \&fstab_list,
  938.              update => \&fstab_update},
  939.             {packages => 'grub grub-legacy',
  940.              path => grub1_path(),
  941.              list => \&grub1_list,
  942.              update => \&grub1_update,
  943.              post_update => \&grub1_post,
  944.              is_boot_loader => 1},
  945.             {packages => 'grub-common',
  946.              path => '/etc/default/grub',
  947.              list => \&grub2_list,
  948.              update => \&grub2_update,
  949.              post_update => \&grub2_post,
  950.              is_boot_loader => 1},
  951.             {packages => 'lilo',
  952.              path => '/etc/lilo.conf',
  953.              list => \&lilo_list,
  954.              update => \&lilo_update,
  955.              post_update => \&lilo_post,
  956.              is_boot_loader => 1},
  957.             {packages => 'silo',
  958.              path => '/etc/silo.conf',
  959.              list => \&lilo_list,
  960.              update => \&lilo_update,
  961.              post_update => \&silo_post,
  962.              is_boot_loader => 1},
  963.             {packages => 'quik',
  964.              path => '/etc/quik.conf',
  965.              list => \&lilo_list,
  966.              update => \&lilo_update,
  967.              is_boot_loader => 1},
  968.             {packages => 'yaboot',
  969.              path => '/etc/yaboot.conf',
  970.              list => \&lilo_list,
  971.              update => \&lilo_update,
  972.              post_update => \&yaboot_post,
  973.              is_boot_loader => 1},
  974.             {packages => 'elilo',
  975.              path => '/etc/elilo.conf',
  976.              list => \&lilo_list,
  977.              update => \&elilo_update,
  978.              post_update => \&elilo_post,
  979.              is_boot_loader => 1},
  980.             {packages => 'extlinux',
  981.              path => extlinux_old_path(),
  982.              list => \&extlinux_old_list,
  983.              update => \&extlinux_old_update,
  984.              post_update => \&extlinux_post,
  985.              is_boot_loader => 1},
  986.             {packages => 'extlinux',
  987.              path => '/etc/default/extlinux',
  988.              list => \&extlinux_new_list,
  989.              update => \&extlinux_new_update,
  990.              post_update => \&extlinux_post,
  991.              is_boot_loader => 1},
  992.             {packages => 'udev',
  993.              path => '/etc/udev/rules.d/70-persistent-cd.rules',
  994.              needs_update => \&udev_cd_needs_update,
  995.              update => \&udev_cd_update},
  996.             {packages => 'initramfs-tools',
  997.              path => '/etc/initramfs-tools/conf.d/resume',
  998.              list => \&initramfs_resume_list,
  999.              update => \&initramfs_resume_update,
  1000.              # udev will source all files in this directory,
  1001.              # with few exceptions.  Such as including a '^'.
  1002.              suffix => '^old'},
  1003.             {packages => 'uswsusp',
  1004.              path => '/etc/uswsusp.conf',
  1005.              list => \&uswsusp_resume_list,
  1006.              update => \&uswsusp_resume_update},
  1007.             {packages => 'cryptsetup',
  1008.              path => '/etc/crypttab',
  1009.              list => \&cryptsetup_list,
  1010.              update => \&cryptsetup_update},
  1011.             # mdadm.conf requires manual update because it may
  1012.             # contain wildcards.
  1013.             {packages => 'mdadm',
  1014.              path => '/etc/mdadm/mdadm.conf',
  1015.              list => \&mdadm_list},
  1016.             # hdparm.conf requires manual update because it
  1017.             # (1) refers to whole disks (2) might not work
  1018.             # properly with the new drivers (3) is in a very
  1019.             # special format.
  1020.             {packages => 'hdparm',
  1021.              path => '/etc/hdparm.conf',
  1022.              list => \&hdparm_list});
  1023.  
  1024. ### Filesystem labels and UUIDs
  1025.  
  1026. sub ext2_set_label {
  1027.     my ($bdev, $label) = @_;
  1028.     system('tune2fs', '-L', $label, $bdev) == 0 or die "tune2fs failed: $?";
  1029. }
  1030. sub ext2_set_uuid {
  1031.     my ($bdev, $uuid) = @_;
  1032.     system('tune2fs', '-U', $uuid, $bdev) == 0 or die "tune2fs failed: $?";
  1033. }
  1034.  
  1035. sub jfs_set_label {
  1036.     my ($bdev, $label) = @_;
  1037.     system('jfs_tune', '-L', $label, $bdev) == 0 or die "jfs_tune failed: $?";
  1038. }
  1039. sub jfs_set_uuid {
  1040.     my ($bdev, $uuid) = @_;
  1041.     system('jfs_tune', '-U', $uuid, $bdev) == 0 or die "jfs_tune failed: $?";
  1042. }
  1043.  
  1044. sub fat_set_label {
  1045.     my ($bdev, $label) = @_;
  1046.     system('dosfslabel', $bdev, $label) == 0 or die "dosfslabel failed: $?";
  1047. }
  1048.  
  1049. sub ntfs_set_label {
  1050.     my ($bdev, $label) = @_;
  1051.     system('ntfslabel', $bdev, $label) == 0 or die "ntfslabel failed: $?";
  1052. }
  1053.  
  1054. sub reiserfs_set_label {
  1055.     my ($bdev, $label) = @_;
  1056.     system('reiserfstune', '--label', $label, $bdev)
  1057.     or die "reiserfstune failed: $?";
  1058. }
  1059. sub reiserfs_set_uuid {
  1060.     my ($bdev, $uuid) = @_;
  1061.     system('reiserfstune', '--uuid', $uuid, $bdev)
  1062.     or die "reiserfstune failed: $?";
  1063. }
  1064.  
  1065. # There is no command to relabel swap, and we mustn't run mkswap if
  1066. # the partition is already in use.  Thankfully the header format is
  1067. # pretty simple; it starts with this structure:
  1068. # struct swap_header_v1_2 {
  1069. #     char          bootbits[1024];    /* Space for disklabel etc. */
  1070. #     unsigned int  version;
  1071. #     unsigned int  last_page;
  1072. #     unsigned int  nr_badpages;
  1073. #     unsigned char uuid[16];
  1074. #     char          volume_name[16];
  1075. #     unsigned int  padding[117];
  1076. #     unsigned int  badpages[1];
  1077. # };
  1078. # and has the signature 'SWAPSPACE2' at the end of the first page.
  1079. use constant { SWAP_SIGNATURE => 'SWAPSPACE2',
  1080.            SWAP_UUID_OFFSET => 1036, SWAP_UUID_LEN => 16,
  1081.            SWAP_LABEL_OFFSET => 1052, SWAP_LABEL_LEN => 16 };
  1082. sub _swap_set_field {
  1083.     my ($bdev, $offset, $value) = @_;
  1084.     my $pagesize = POSIX::sysconf(POSIX::_SC_PAGESIZE) or die "$!";
  1085.     my ($length, $signature);
  1086.  
  1087.     my $fd = POSIX::open($bdev, POSIX::O_RDWR);
  1088.     defined($fd) or die "$!";
  1089.  
  1090.     # Check the signature
  1091.     POSIX::lseek($fd, $pagesize - length(SWAP_SIGNATURE), POSIX::SEEK_SET);
  1092.     $length = POSIX::read($fd, $signature, length(SWAP_SIGNATURE));
  1093.     if (!defined($length) || $signature ne SWAP_SIGNATURE) {
  1094.     POSIX::close($fd);
  1095.     die "swap signature not found on $bdev";
  1096.     }
  1097.  
  1098.     # Set the field
  1099.     POSIX::lseek($fd, $offset, POSIX::SEEK_SET);
  1100.     $length = POSIX::write($fd, $value, length($value));
  1101.     if (!defined($length) || $length != length($value)) {
  1102.     my $error = "$!";
  1103.     POSIX::close($fd);
  1104.     die $error;
  1105.     }
  1106.  
  1107.     POSIX::close($fd);
  1108. }
  1109. sub swap_set_label {
  1110.     my ($bdev, $label) = @_;
  1111.     _swap_set_field($bdev, SWAP_LABEL_OFFSET, pack('Z' . SWAP_LABEL_LEN, $label));
  1112. }
  1113. sub swap_set_uuid {
  1114.     my ($bdev, $uuid) = @_;
  1115.     my $uuid_bin;
  1116.     if (UUID::parse($uuid, $uuid_bin) != 0 ||
  1117.     length($uuid_bin) != SWAP_UUID_LEN) {
  1118.     die "internal error: invalid UUID string";
  1119.     }
  1120.     _swap_set_field($bdev, SWAP_UUID_OFFSET, $uuid_bin);
  1121. }
  1122.  
  1123. sub ufs_set_label {
  1124.     my ($bdev, $label) = @_;
  1125.     system('tunefs.ufs', '-L', $label, $bdev) or die "tunefs.ufs failed: $?";
  1126. }
  1127.  
  1128. sub xfs_set_label {
  1129.     my ($bdev, $label) = @_;
  1130.     system('xfs_admin', '-L', $label, $bdev) or die "xfs_admin failed: $?";
  1131. }
  1132. sub xfs_set_uuid {
  1133.     my ($bdev, $uuid) = @_;
  1134.     system('xfs_admin', '-U', $uuid, $bdev) or die "xfs_admin failed: $?";
  1135. }
  1136.  
  1137. my %filesystem_types = (
  1138.     ext2     => { label_len => 16,             set_label => \&ext2_set_label,
  1139.           set_uuid  => \&ext2_set_uuid },
  1140.     ext3     => { label_len => 16,             set_label => \&ext2_set_label,
  1141.           set_uuid  => \&ext2_set_uuid },
  1142.     ext4     => { label_len => 16,             set_label => \&ext2_set_label,
  1143.           set_uuid  => \&ext2_set_uuid },
  1144.     jfs      => { label_len => 16,             set_label => \&jfs_set_label,
  1145.           set_uuid  => \&jfs_set_uuid },
  1146.     msdos    => { label_len => 11,             set_label => \&fat_set_label },
  1147.     ntfs     => { label_len => 128,            set_label => \&ntfs_set_label },
  1148.     reiserfs => { label_len => 16,             set_label => \&reiserfs_set_label,
  1149.           set_uuid  => \&reiserfs_set_uuid },
  1150.     swap     => { label_len => SWAP_LABEL_LEN, set_label => \&swap_set_label,
  1151.           set_uuid  => \&swap_set_uuid },
  1152.     ufs      => { label_len => 32,             set_label => \&ufs_set_label },
  1153.     vfat     => { label_len => 11,             set_label => \&fat_set_label },
  1154.     xfs      => { label_len => 12,             set_label => \&xfs_set_label,
  1155.           set_uuid  => \&xfs_set_uuid }
  1156.     );
  1157.  
  1158. my %bdev_map;
  1159. my %id_map;
  1160.  
  1161. sub scan_config_files {
  1162.     my $bdev_regex = shift;
  1163.     my @configs;
  1164.  
  1165.     # Find all matching devices mentioned in configurations
  1166.     for my $config (@config_files) {
  1167.     # Is the file present?
  1168.     my $path = $config->{path};
  1169.     if (!defined($path)) {
  1170.         next;
  1171.     }
  1172.     my $file = new FileHandle($path, 'r');
  1173.     if (!defined($file)) {
  1174.         if ($! == POSIX::ENOENT) {
  1175.         next;
  1176.         }
  1177.         die "$!";
  1178.     }
  1179.  
  1180.     # Are any of the related packages wanted or installed?
  1181.     my $wanted = 0;
  1182.     my $unpacked = 0;
  1183.     my $installed = 0;
  1184.     my $packages = $config->{packages};
  1185.     for (`dpkg-query 2>/dev/null --showformat '\${status}\\n' -W $packages`)
  1186.     {
  1187.         $wanted = 1 if /^install /;
  1188.         $installed = 1 if / installed\n$/;
  1189.         $unpacked = 1 if / (installed|unpacked)\n$/;
  1190.     }
  1191.     if (!$wanted && !$unpacked) {
  1192.         next;
  1193.     }
  1194.  
  1195.     my @matched_bdevs = ();
  1196.     my $id_map_text;
  1197.     my $needs_update;
  1198.  
  1199.     if (exists($config->{needs_update})) {
  1200.         $id_map_text = &{$config->{needs_update}}($file);
  1201.         $needs_update = defined($id_map_text) && $id_map_text ne '';
  1202.     } elsif (exists($config->{list})) {
  1203.         for my $bdev (&{$config->{list}}($file)) {
  1204.         # Check whether the device name matches the given
  1205.         # regex.  Also check that the device node exists,
  1206.         # unless the name is a wildcard.
  1207.         if ($bdev =~ $bdev_regex && ($bdev =~ m/[\?\*]/ || -b $bdev)) {
  1208.             $bdev_map{$bdev} = {};
  1209.             push @matched_bdevs, $bdev;
  1210.         }
  1211.         }
  1212.         $needs_update = @matched_bdevs > 0;
  1213.     } else {
  1214.         # Needs manual update
  1215.         $needs_update = 1;
  1216.     }
  1217.  
  1218.     push @configs, {config => $config,
  1219.             devices => \@matched_bdevs,
  1220.             id_map_text => $id_map_text,
  1221.             installed => $installed,
  1222.             unpacked => $unpacked,
  1223.             needs_update => $needs_update};
  1224.     }
  1225.  
  1226.     my $fstab = new FileHandle('/etc/fstab', 'r') or die "$!";
  1227.     while (1) {
  1228.     my ($text, $bdev, $path, $type) = fstab_next($fstab);
  1229.     last unless defined($text);
  1230.     if (defined($type) && exists($bdev_map{$bdev})) {
  1231.         $bdev_map{$bdev}->{path} = $path;
  1232.         $bdev_map{$bdev}->{type} = $type;
  1233.     }
  1234.     }
  1235.     $fstab->close();
  1236.  
  1237.     return @configs;
  1238. }
  1239.  
  1240. sub add_tag {
  1241.     # Map disks to labels/UUIDs and vice versa.  Include all disks in
  1242.     # the reverse mapping so we can detect ambiguity.
  1243.     my ($bdev, $name, $value, $new) = @_;
  1244.     my $id = "$name=$value";
  1245.     push @{$id_map{$id}}, $bdev;
  1246.     if (exists($bdev_map{$bdev})) {
  1247.     $bdev_map{$bdev}->{$name} = $value;
  1248.     push @{$bdev_map{$bdev}->{ids}}, $id;
  1249.     }
  1250.     if ($new) {
  1251.     $bdev_map{$bdev}->{new_id} = $id;
  1252.     }
  1253. }
  1254.  
  1255. sub scan_devices {
  1256.     my $id_command;
  1257.     if (-x '/sbin/vol_id') {
  1258.     $id_command = '/sbin/vol_id';
  1259.     } else {
  1260.     $id_command = 'blkid -o udev -s LABEL -s UUID -s TYPE';
  1261.     }
  1262.     for (`blkid -o device`) {
  1263.     chomp;
  1264.     my $bdev = $_;
  1265.     for (`$id_command '$bdev'`) {
  1266.         if (/^ID_FS_(LABEL|UUID)_ENC=(.+)\n$/) {
  1267.         add_tag($bdev, $1, $2);
  1268.         } elsif (/^ID_FS_TYPE=(.+)\n$/ && exists($bdev_map{$bdev})) {
  1269.         $bdev_map{$bdev}->{type} //= $1;
  1270.         }
  1271.     }
  1272.     }
  1273.  
  1274.     # Discard UUIDs for LVM2 PVs, as we assume there are symlinks for all
  1275.     # UUIDs under /dev/disk/by-uuid and this is not true for PVs.
  1276.     # Discard all labels and UUIDs(!) that are ambiguous.
  1277.     # Discard all labels with 'unsafe' characters (escaped by blkid using
  1278.     # backslashes) as they will not be usable in all configuration files.
  1279.     # Similarly for '#' which blkid surprisingly does not consider unsafe.
  1280.     # Sort each device's IDs in reverse lexical order so that UUIDs are
  1281.     # preferred.
  1282.     for my $bdev (keys(%bdev_map)) {
  1283.     if (!defined($bdev_map{$bdev}->{type}) ||
  1284.         $bdev_map{$bdev}->{type} eq 'LVM2_member') {
  1285.         @{$bdev_map{$bdev}->{ids}} = ();
  1286.     } else {
  1287.         @{$bdev_map{$bdev}->{ids}} =
  1288.         sort({$b cmp $a}
  1289.              grep({ @{$id_map{$_}} == 1 && $_ !~ /[\\#]/ }
  1290.               @{$bdev_map{$bdev}->{ids}}));
  1291.     }
  1292.     }
  1293.  
  1294.     # Add persistent aliases for CD/DVD/BD drives
  1295.     my $cd_rules =
  1296.     new FileHandle('/etc/udev/rules.d/70-persistent-cd.rules', 'r');
  1297.     while (defined($cd_rules)) {
  1298.     my @keys = udev_next($cd_rules);
  1299.     last if $#keys < 0;
  1300.  
  1301.     my ($path, $symlink) = udev_parse_symlink_rule(@keys);
  1302.     if (defined($path) && defined($symlink)) {
  1303.         $symlink =~ s{^(?!/)}{/dev/};
  1304.         my $bdev = readlink($symlink) or next;
  1305.         $bdev =~ s{^(?!/)}{/dev/};
  1306.         if (exists($bdev_map{$bdev})) {
  1307.         push @{$bdev_map{$bdev}->{ids}}, $symlink;
  1308.         }
  1309.     }
  1310.     }
  1311. }
  1312.  
  1313. sub assign_new_ids {
  1314.     my $hostname = (POSIX::uname())[1];
  1315.  
  1316.     # For all devices that have no alternate device ids, suggest setting
  1317.     # UUIDs, labelling them based on fstab or just using a generic label.
  1318.     for my $bdev (keys(%bdev_map)) {
  1319.     next if $#{$bdev_map{$bdev}->{ids}} >= 0;
  1320.  
  1321.     my $type = $bdev_map{$bdev}->{type};
  1322.     next unless defined($type) && exists($filesystem_types{$type});
  1323.  
  1324.     if (defined($filesystem_types{$type}->{set_uuid})) {
  1325.         my ($uuid_bin, $uuid);
  1326.         UUID::generate($uuid_bin);
  1327.         UUID::unparse($uuid_bin, $uuid);
  1328.         add_tag($bdev, 'UUID', $uuid, 1);
  1329.         next;
  1330.     }
  1331.  
  1332.     my $label_len = $filesystem_types{$type}->{label_len};
  1333.     my $label;
  1334.     use bytes; # string lengths are in bytes
  1335.  
  1336.     if (defined($bdev_map{$bdev}->{path})) {
  1337.         # Convert path/type to label; prepend hostname if possible;
  1338.         # append numeric suffix if necessary.
  1339.  
  1340.         my $base;
  1341.         if ($bdev_map{$bdev}->{path} =~ m|^/|) {
  1342.         $base = $bdev_map{$bdev}->{path};
  1343.         } else {
  1344.         $base = $bdev_map{$bdev}->{type};
  1345.         }
  1346.         $base =~ s/[^\w]+/-/g;
  1347.         $base =~ s/^-//g;
  1348.         $base =~ s/-$//g;
  1349.  
  1350.         my $n = 0;
  1351.         my $suffix = '';
  1352.         do {
  1353.         $label = "$hostname-$base$suffix";
  1354.         if (length($label) > $label_len) {
  1355.             $label = substr($base, 0, $label_len - length($suffix))
  1356.             . $suffix;
  1357.         }
  1358.         $n++;
  1359.         $suffix = "-$n";
  1360.         } while (exists($id_map{"LABEL=$label"}));
  1361.     } else {
  1362.         my $n = 0;
  1363.         my $suffix;
  1364.         do {
  1365.         $n++;
  1366.         $suffix = "-$n";
  1367.         $label = substr($hostname, 0, $label_len - length($suffix))
  1368.             . $suffix;
  1369.         } while (exists($id_map{"LABEL=$label"}));
  1370.     }
  1371.  
  1372.     add_tag($bdev, 'LABEL', $label, 1);
  1373.     }
  1374. }
  1375.  
  1376. sub set_new_ids {
  1377.     for my $bdev (keys(%bdev_map)) {
  1378.     my $bdev_info = $bdev_map{$bdev};
  1379.     if ($bdev_info->{new_id}) {
  1380.         my ($name, $value) = split(/=/, $bdev_info->{new_id}, 2);
  1381.         my $setter;
  1382.         if ($name eq 'UUID') {
  1383.         $setter = $filesystem_types{$bdev_info->{type}}->{set_uuid};
  1384.         } elsif ($name eq 'LABEL') {
  1385.         $setter = $filesystem_types{$bdev_info->{type}}->{set_label};
  1386.         }
  1387.         defined($setter) or die "internal error: invalid new_id type";
  1388.         &{$setter}($bdev, $value);
  1389.     }
  1390.     }
  1391. }
  1392.  
  1393. sub update_config {
  1394.     my $map = shift;
  1395.  
  1396.     for my $match (@_) {
  1397.     # Generate a new config
  1398.     my $path = $match->{config}->{path};
  1399.     my $old = new FileHandle($path, 'r') or die "$!";
  1400.     my $new = new FileHandle("$path.new", POSIX::O_WRONLY | POSIX::O_CREAT,
  1401.                  0600)
  1402.         or die "$!";
  1403.     &{$match->{config}->{update}}($old, $new, $map);
  1404.     $old->close();
  1405.     $new->close();
  1406.  
  1407.     # New config should have same permissions as the old
  1408.     my (undef, undef, $mode, undef, $uid, $gid) = stat($path) or die "$!";
  1409.     chown($uid, $gid, "$path.new") or die "$!";
  1410.     chmod($mode & 07777, "$path.new") or die "$!";
  1411.  
  1412.     # Back up the old config and replace with the new
  1413.     my $old_path = $path . ($match->{config}->{suffix} || '.old');
  1414.     unlink($old_path);
  1415.     link($path, $old_path) or die "$!";
  1416.     rename("$path.new", $path) or die "$!";
  1417.  
  1418.     # If the package is installed, run the post-update function.
  1419.     # If the package is only unpacked, assume that its own postinst
  1420.     # will cover this.
  1421.     if ($match->{installed} && $match->{config}->{post_update}) {
  1422.         &{$match->{config}->{post_update}}();
  1423.     }
  1424.     }
  1425. }
  1426.  
  1427. sub update_all {
  1428.     # The update process may be aborted if a command fails, but we now
  1429.     # want to recover and ask the user what to do.  We can use 'do' to
  1430.     # prevent 'die' from exiting the process, but we also need to
  1431.     # capture and present error messages using debconf as they may
  1432.     # otherwise be hidden.  Therefore, we fork and capture stdout and
  1433.     # stderr from the update process in the main process.
  1434.     my $pid = open(PIPE, '-|');
  1435.     return (-1, '') unless defined $pid;
  1436.  
  1437.     if ($pid == 0) {
  1438.     # Complete redirection
  1439.     # </dev/null
  1440.     POSIX::close(0);
  1441.     POSIX::open('/dev/null', POSIX::O_RDONLY) or die "$!";
  1442.     # 2>&1
  1443.     POSIX::dup2(1, 2) or die "$!";
  1444.  
  1445.     # Do the update
  1446.     set_new_ids();
  1447.     update_config(@_);
  1448.     exit;
  1449.     } else {
  1450.     my @output = ();
  1451.     while (<PIPE>) {
  1452.         push @output, $_;
  1453.     }
  1454.     close(PIPE);
  1455.     return ($?, join('', @output));
  1456.     }
  1457. }
  1458.  
  1459. sub transition {
  1460.     use Debconf::Client::ConfModule ':all';
  1461.  
  1462.     my $bdev_regex = shift;
  1463.  
  1464. retry:
  1465.     %bdev_map = ();
  1466.     %id_map = ();
  1467.  
  1468.     my @found_configs = scan_config_files($bdev_regex);
  1469.     my @matched_configs = grep({$_->{needs_update}} @found_configs);
  1470.     my @auto_configs = grep({defined($_->{config}->{update})} @matched_configs);
  1471.     my $found_boot_loader =
  1472.     grep({$_->{config}->{is_boot_loader} && $_->{unpacked}} @found_configs);
  1473.     my %update_map = ();
  1474.  
  1475.     # We can skip all of this if we didn't find any configuration
  1476.     # files that need conversion and we found the configuration file
  1477.     # for an installed boot loader.
  1478.     if (!@matched_configs && $found_boot_loader) {
  1479.     return;
  1480.     }
  1481.  
  1482.     my ($question, $answer, $ret, $seen);
  1483.  
  1484.     $question = 'linux-base/disk-id-convert-auto';
  1485.     ($ret, $seen) = input('high', $question);
  1486.     if ($ret && $ret != 30) {
  1487.     die "Error setting debconf question $question: $seen";
  1488.     }
  1489.     ($ret, $seen) = go();
  1490.     if ($ret && $ret != 30) {
  1491.     die "Error asking debconf question $question: $seen";
  1492.     }
  1493.     ($ret, $answer) = get($question);
  1494.     die "Error retrieving answer for $question: $answer" if $ret;
  1495.  
  1496.     if (@auto_configs && $answer eq 'true') {
  1497.     scan_devices();
  1498.     assign_new_ids();
  1499.  
  1500.     # Construct the device ID update map
  1501.     for my $bdev (keys(%bdev_map)) {
  1502.         if (@{$bdev_map{$bdev}->{ids}}) {
  1503.         $update_map{$bdev} = $bdev_map{$bdev}->{ids}->[0];
  1504.         }
  1505.     }
  1506.  
  1507.     # Weed out configurations which will be unaffected by this
  1508.     # mapping or by a custom mapping described in id_map_text.
  1509.     @auto_configs = grep({ defined($_->{id_map_text}) ||
  1510.                    grep({exists($update_map{$_})}
  1511.                     @{$_->{devices}}) }
  1512.                  @auto_configs);
  1513.     }
  1514.  
  1515.     if (@auto_configs && $answer eq 'true') {
  1516.     if (grep({$bdev_map{$_}->{new_id}} keys(%bdev_map))) {
  1517.         $question = 'linux-base/disk-id-convert-plan';
  1518.         ($ret, $seen) = subst($question, 'relabel',
  1519.                   join("\\n",
  1520.                        map({sprintf("%s: %s",
  1521.                             $_, $bdev_map{$_}->{new_id})}
  1522.                        grep({$bdev_map{$_}->{new_id}}
  1523.                         keys(%bdev_map)))));
  1524.         die "Error setting debconf substitutions in $question: $seen" if $ret;
  1525.     } else {
  1526.         $question = 'linux-base/disk-id-convert-plan-no-relabel';
  1527.     }
  1528.     ($ret, $seen) = subst($question, 'id_map',
  1529.                   join("\\n",
  1530.                    map({sprintf("%s: %s", $_, $update_map{$_})}
  1531.                        keys(%update_map)),
  1532.                    grep({defined}
  1533.                     map({$_->{id_map_text}} @auto_configs))));
  1534.     die "Error setting debconf substitutions in $question: $seen" if $ret;
  1535.     ($ret, $seen) = subst($question, 'files',
  1536.                   join(', ',
  1537.                    map({$_->{config}->{path}} @auto_configs)));
  1538.     die "Error setting debconf substitutions in $question: $seen" if $ret;
  1539.     ($ret, $seen) = input('high', $question);
  1540.     if ($ret && $ret != 30) {
  1541.         die "Error setting debconf question $question: $seen";
  1542.     }
  1543.     ($ret, $seen) = go();
  1544.     if ($ret && $ret != 30) {
  1545.         die "Error asking debconf question $question: $seen";
  1546.     }
  1547.     ($ret, $answer) = get($question);
  1548.     die "Error retrieving answer for $question: $answer" if $ret;
  1549.     
  1550.     if ($answer eq 'true') {
  1551.         my ($rc, $output) = update_all(\%update_map, @auto_configs);
  1552.         if ($rc != 0) {
  1553.         # Display output of update commands
  1554.         $question = 'linux-base/disk-id-update-failed';
  1555.         $output =~ s/\n/\\n/g;
  1556.         ($ret, $seen) = subst($question, 'output', $output);
  1557.         die "Error setting debconf substitutions in $question: $seen"
  1558.             if $ret;
  1559.         ($ret, $seen) = input('high', $question);
  1560.         if ($ret && $ret != 30) {
  1561.             die "Error setting debconf question $question: $seen";
  1562.         }
  1563.         ($ret, $seen) = go();
  1564.         if ($ret && $ret != 30) {
  1565.             die "Error asking debconf question $question: $seen";
  1566.         }
  1567.  
  1568.         # Mark previous questions as unseen
  1569.         fset('linux-base/disk-id-convert-auto', 'seen', 'false');
  1570.         fset('linux-base/disk-id-convert-plan', 'seen', 'false');
  1571.         fset('linux-base/disk-id-convert-plan-no-relabel', 'seen',
  1572.              'false');
  1573.         goto retry;
  1574.         }
  1575.     }
  1576.     }
  1577.  
  1578.     my @unconv_files = ();
  1579.     for my $match (@matched_configs) {
  1580.     if (!defined($match->{config}->{update})) {
  1581.         push @unconv_files, $match->{config}->{path};
  1582.     } else {
  1583.         my @unconv_bdevs = grep({!exists($update_map{$_})}
  1584.                     @{$match->{devices}});
  1585.         if (@unconv_bdevs) {
  1586.         push @unconv_files, sprintf('%s: %s', $match->{config}->{path},
  1587.                         join(', ',@unconv_bdevs));
  1588.         }
  1589.     }
  1590.     }
  1591.     if (@unconv_files) {
  1592.     $question = 'linux-base/disk-id-manual';
  1593.     ($ret, $seen) = subst($question, 'unconverted',
  1594.                   join("\\n", @unconv_files));
  1595.     die "Error setting debconf substitutions in $question: $seen" if $ret;
  1596.     ($ret, $seen) = input('high', $question);
  1597.     if ($ret && $ret != 30) {
  1598.         die "Error setting debconf note $question: $seen";
  1599.     }
  1600.     ($ret, $seen) = go();
  1601.     if ($ret && $ret != 30) {
  1602.         die "Error showing debconf note $question: $seen";
  1603.     }
  1604.     }
  1605.  
  1606.     # Also note whether some (unknown) boot loader configuration file
  1607.     # must be manually converted.
  1608.     if (!$found_boot_loader) {
  1609.     $question = 'linux-base/disk-id-manual-boot-loader';
  1610.     ($ret, $seen) = input('high', $question);
  1611.     if ($ret && $ret != 30) {
  1612.         die "Error setting debconf note $question: $seen";
  1613.     }
  1614.     ($ret, $seen) = go();
  1615.     if ($ret && $ret != 30) {
  1616.         die "Error showing debconf note $question: $seen";
  1617.     }
  1618.     }
  1619. }
  1620.  
  1621. package DebianKernel::BootloaderConfig;
  1622.  
  1623. my %default_bootloader = (amd64 => 'lilo',
  1624.               i386  => 'lilo',
  1625.               ia64  => 'elilo',
  1626.               s390  => 'zipl');
  1627.  
  1628. sub check {
  1629.     use Debconf::Client::ConfModule ':all';
  1630.  
  1631.     my ($deb_arch) = @_;
  1632.  
  1633.     # Is there an historical 'default' boot loader for this architecture?
  1634.     my $loader_exec = $default_bootloader{$deb_arch};
  1635.     return unless defined($loader_exec);
  1636.  
  1637.     # Is the boot loader installed?
  1638.     my ($loaderloc) = grep(-x, map("$_/$loader_exec",
  1639.                    map({ length($_) ? $_ : "." }
  1640.                        split(/:/, $ENV{PATH}))));
  1641.     return unless defined($loaderloc);
  1642.  
  1643.     # Is do_bootloader explicitly set one way or the other?
  1644.     my $do_bootloader;
  1645.     if (my $conf = new FileHandle('/etc/kernel-img.conf', 'r')) {
  1646.     while (<$conf>) {
  1647.         $do_bootloader = 0 if /^\s*do_bootloader\s*=\s*(no|false|0)\s*$/i;
  1648.         $do_bootloader = 1 if /^\s*do_bootloader\s*=\s*(yes|true|1)\s*$/i;
  1649.     }
  1650.     $conf->close();
  1651.     }
  1652.     return if defined($do_bootloader);
  1653.  
  1654.     # Warn the user that do_bootloader is disabled by default.
  1655.     my ($question, $ret, $seen);
  1656.     $question = "linux-base/do-bootloader-default-changed";
  1657.     ($ret,$seen) = input('high', "$question");
  1658.     die "Error setting debconf question $question: $seen" if $ret && $ret != 30;
  1659.     ($ret,$seen) = go();
  1660.     die "Error asking debconf question $question: $seen" if $ret && $ret != 30;
  1661. }
  1662.  
  1663. package main;
  1664.  
  1665. capb('escape');
  1666.  
  1667. sub version_lessthan {
  1668.     my ($left, $right) = @_;
  1669.     return system('dpkg', '--compare-versions', $left, 'lt', $right) == 0;
  1670. }
  1671.  
  1672. # No upgrade work is necessary during a fresh system installation.
  1673. # But since linux-base is a new dependency of linux-image-* and did
  1674. # not exist until needed for the libata transition, we cannot simply
  1675. # test whether this is a fresh installation of linux-base.  Instead,
  1676. # we test:
  1677. # - does /etc/fstab exist yet (this won't even work without it), and
  1678. # - are any linux-image-* packages installed yet?
  1679. sub is_fresh_installation {
  1680.     if (-f '/etc/fstab') {
  1681.     for (`dpkg-query 2>/dev/null --showformat '\${status}\\n' -W 'linux-image-*'`) {
  1682.         return 0 if / installed\n$/;
  1683.     }
  1684.     }
  1685.     return 1;
  1686. }
  1687.  
  1688. my $deb_arch = `dpkg --print-architecture`;
  1689. chomp $deb_arch;
  1690.  
  1691. my $reconfigure = ($ARGV[0] eq 'reconfigure' ||
  1692.            defined($ENV{DEBCONF_RECONFIGURE}));
  1693. if ($deb_arch ne 's390' && ($reconfigure || !is_fresh_installation())) {
  1694.     my @bdev_regex = ();
  1695.  
  1696.     my $libata_transition_ver =
  1697.     ($deb_arch eq 'i386' || $deb_arch eq 'amd64') ? '2.6.32-10' : '2.6.32-11';
  1698.     if ($reconfigure || version_lessthan($ARGV[1], $libata_transition_ver)) {
  1699.     # Match standard IDE and SCSI device names, plus wildcards
  1700.     # in disk device names to allow for mdadm insanity.
  1701.     push @bdev_regex, '[hs]d[a-z\?\*][\d\?\*]*$';
  1702.     push @bdev_regex, 's(?:cd|r)\d+$';
  1703.     }
  1704.  
  1705.     # hpsa took over some controllers from cciss in 2.6.37, so their
  1706.     # targets are also treated (and named) like SCSI devices now.
  1707.     if ($reconfigure || version_lessthan($ARGV[1], '3')) {
  1708.     push @bdev_regex, 'cciss/';
  1709.     push @bdev_regex, 'sd[a-z\?\*][\d\?\*]*$';
  1710.     }
  1711.  
  1712.     if (@bdev_regex) {
  1713.     DebianKernel::DiskId::transition('^/dev/(?:' .
  1714.                      join('|', @bdev_regex) . ')');
  1715.     }
  1716. }
  1717.  
  1718. if (!is_fresh_installation() && version_lessthan($ARGV[1], '2.6.32-18')) {
  1719.     DebianKernel::BootloaderConfig::check($deb_arch);
  1720. }
  1721.  
  1722. exec("set -e\nset -- @ARGV\n" . << 'EOF');
  1723.  
  1724. EOF
  1725.